﻿Imports System.Net.Sockets
Imports System.Net

Public Class TCPClientEx
    Inherits Socket


    Public Sub New()
        MyBase.New(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
    End Sub

    Public Sub New(ByVal ServerAddr As String, ByVal iPort As Integer)
        MyBase.New(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)

        Me.ServerAddr = ServerAddr
        Me.ServerPort = iPort
    End Sub

    Public Function toDNSString() As String
        If Not ServerDNSInfo Is Nothing Then

            If Not ServerDNSInfo.AddressList.Length = 0 Then
                Dim ipAddress As IPAddress = ServerDNSInfo.AddressList(0)
                Return ReplaceEx("IP:%1(Addr:%2):Port:%3", {ipAddress.ToString, ServerAddr, ServerPort})
            Else
                Return "NULL"
            End If

        Else
            Return ReplaceEx("IP:%1:Port:%2", {ServerAddr, ServerPort})
        End If
    End Function


    ''' <summary>
    ''' 输出远程连接端信息
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function toRemoteString() As String
        Try
            If State = SocketStateEnum.eCloseed Then
                Return ReplaceEx("IP:%1:Port:%2", {ServerAddr, ServerPort})
            End If
            If RemoteEndPoint IsNot Nothing Then
                Return RemoteEndPoint.ToString
            Else
                Return "ERR"
            End If
        Catch ex As Exception
            Return ReplaceEx("IP:%1:Port:%2", {ServerAddr, ServerPort})
        End Try
        
    End Function

    ''' <summary>
    ''' 输出本地连接端信息
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function toLocalString() As String
        Try
            If State = SocketStateEnum.eCloseed Then
                Return "NULL"
            End If

            Return LocalEndPoint.ToString
        Catch ex As Exception
            Debug.Print("toLocalString Err" & ex.ToString)
            Return "Err"
        End Try
    End Function

    ''' <summary>
    ''' 已连接
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function IsConnected() As Boolean
        Return mSocketState = SocketStateEnum.eConnected
    End Function


    ''' <summary>
    ''' 连接错误信息
    ''' </summary>
    ''' <remarks></remarks>
    Private mSocketErrCode As Integer
    ''' <summary>
    ''' 连接错误信息
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property ErrCode As Integer
        Get
            Return mSocketErrCode
        End Get
    End Property

    ''' <summary>
    ''' 连接状态
    ''' </summary>
    ''' <remarks></remarks>
    Private mSocketState As SocketStateEnum = SocketStateEnum.eCloseed
    ''' <summary>
    ''' 连接状态
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property State As SocketStateEnum
        Get
            Return mSocketState
        End Get
    End Property

    ''' <summary>
    ''' socket连接状态
    ''' </summary>
    ''' <remarks></remarks>
    Public Enum SocketStateEnum
        ''' <summary>
        ''' 关闭中
        ''' </summary>
        ''' <remarks></remarks>
        eCloseed

        ''' <summary>
        ''' 正在查询远程主机DNS
        ''' </summary>
        ''' <remarks></remarks>
        eSearchDNS

        ''' <summary>
        ''' 正在连接远程主机
        ''' </summary>
        ''' <remarks></remarks>
        eConnecting


        ''' <summary>
        ''' 已连接远程主机
        ''' </summary>
        ''' <remarks></remarks>
        eConnected

        ''' <summary>
        ''' 正在监听端口
        ''' </summary>
        ''' <remarks></remarks>
        eListening

        ''' <summary>
        ''' 发生错误
        ''' </summary>
        ''' <remarks></remarks>
        eErr
    End Enum


    
    ''' <summary>
    ''' 服务器地址
    ''' </summary>
    ''' <remarks></remarks>
    Public mServerAddr As String
    ''' <summary>
    ''' 服务器地址
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property ServerAddr As String
        Get
            Return mServerAddr
        End Get
        Set(ByVal value As String)
            mServerAddr = value
        End Set
    End Property

    ''' <summary>
    ''' 服务器服务端口
    ''' </summary>
    ''' <remarks></remarks>
    Private mServerPort As Integer
    ''' <summary>
    ''' 服务器服务端口
    ''' </summary>
    ''' <remarks></remarks>
    Public Property ServerPort As Integer
        Get
            Return mServerPort
        End Get
        Set(ByVal value As Integer)
            mServerPort = value
        End Set
    End Property

    ''' <summary>
    ''' 域名解析的服务器IP列表
    ''' </summary>
    ''' <remarks></remarks>
    Public ServerDNSInfo As IPHostEntry


    ''' <summary>
    ''' 状态发生变化时触发
    ''' </summary>
    ''' <param name="NowState"></param>
    ''' <remarks></remarks>
    Public Event OnStateChanage(ByVal sender As System.Object, ByVal NowState As SocketStateEnum)

    ''' <summary>
    ''' 触发状态变更事件
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub RaiseChanageEvent()
        RaiseEvent OnStateChanage(Me, mSocketState)
    End Sub

    ''' <summary>
    ''' 开始连接服务器
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub BeginConnectEx()
        '首先开始解析DNS
        BeginConnectEx(mServerAddr, mServerPort)
    End Sub

#Region "DNS 查询"


    'DNS的查询结果
    Private mDNSResult As IAsyncResult
    ''' <summary>
    ''' 开始连接服务器
    ''' </summary>
    ''' <param name="ServerAddr"></param>
    ''' <param name="iPort"></param>
    ''' <remarks></remarks>
    Public Sub BeginConnectEx(ByVal ServerAddr As String, ByVal iPort As Integer)
        Dim oIP As IPAddress = Nothing
        '首先开始解析DNS
        If IPAddress.TryParse(ServerAddr, oIP) Then
            ConnectServer(oIP)
        Else
            mDNSResult = Dns.BeginGetHostEntry(ServerAddr, New AsyncCallback(AddressOf DNSHostCallback), Me)

            mSocketState = SocketStateEnum.eSearchDNS
            mSocketErrCode = 0
        End If

    End Sub

    ''' <summary>
    ''' 接收DNS解析
    ''' </summary>
    ''' <param name="ar"></param>
    ''' <remarks></remarks>
    Private Sub DNSHostCallback(ByVal ar As IAsyncResult)
        If mDNSResult Is Nothing Then Return


        Dim oInfo As TCPClientEx = CType(ar.AsyncState, TCPClientEx)
        Try
            mDNSResult = Nothing
            ServerDNSInfo = Dns.EndGetHostEntry(ar)
        Catch ex As SocketException

            If ex.SocketErrorCode = 11004 Then
                '无法使用服务器名进行解析，但是可以使用ip地址直接连接
                Do
                    Dim bIP(3) As Byte, sTmp() As String
                    Dim i As Integer
                    sTmp = ServerAddr.Split(".")
                    If sTmp.Length = 4 Then
                        Try
                            For i = 0 To sTmp.Length - 1
                                bIP(i) = Byte.Parse(sTmp(i))
                            Next
                            Dim ipAddress As IPAddress = New IPAddress(bIP)
                            ConnectServer(ipAddress)
                            Return
                        Catch exIP As Exception
                            Exit Do
                        End Try
                    Else
                        Exit Do
                    End If
                Loop While False
            End If

            SetErred(ex.SocketErrorCode)
            Return
        Catch ex As Exception
            'Debug.Print("DNSHostCallback Err" & ex.ToString)
            Return
        End Try


        If oInfo.ServerDNSInfo.AddressList.Length > 0 Then
            '获取服务器节点
            Dim ipAddress As IPAddress = ServerDNSInfo.AddressList(0)
            ConnectServer(ipAddress)
        End If
    End Sub
#End Region

#Region "连接服务器"

    ''' <summary>
    ''' 连接到服务器
    ''' </summary>
    ''' <param name="oServerIP">服务器IP地址</param>
    ''' <remarks></remarks>
    Private Sub ConnectServer(ByVal oServerIP As IPAddress)

        Dim remoteEP As New IPEndPoint(oServerIP, ServerPort)

        '设置连接超时时间监控器。
        Try
            mConnectWait = New System.Threading.Thread(AddressOf ConnectWait)
            mConnectWait.Name = "wait Connect"
            mConnectWait.Start(remoteEP)
            mConnectTimeoutEnabled = True
        Catch ex As Exception
            Debug.Print("ConnectServer Err" & ex.ToString)
        End Try
    End Sub

#Region "检查连接超时"

    Private mConnectResult As IAsyncResult
    Private mConnectTimeout As Long = 5000 '默认5秒
    Private mConnectTimeoutEnabled As Boolean '是否激活连接超时检测线程
    Private mConnectWait As System.Threading.Thread
    ''' <summary>
    ''' 连接超时时间，服务器连接超时时间，最大30秒，单位毫秒
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property ConnectTimeout As Long
        Get
            Return mConnectTimeout
        End Get
        Set(ByVal value As Long)
            mConnectTimeout = value
        End Set
    End Property

    ''' <summary>
    ''' 检查connect是否超时
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <remarks></remarks>
    Private Sub ConnectWait(ByVal sender As Object)
        Dim oBeginTime As Date = Date.Now
        Dim remoteEP As IPEndPoint = sender

        '开始尝试连接指定的服务器
        mSocketState = SocketStateEnum.eConnecting '正在连接
        RaiseChanageEvent()
        mConnectResult = BeginConnect(remoteEP, New AsyncCallback(AddressOf ConnectCallback), Me)

        Do
            If Not mConnectTimeoutEnabled Then Exit Do

            If State = SocketStateEnum.eCloseed Then Exit Do

            Dim lTime As Long = Date.Now.Subtract(oBeginTime).TotalMilliseconds
            If lTime > mConnectTimeout Then 'xx秒无回应，记为超时
                Close() '关闭连接
                '超时
                mConnectResult = Nothing

                SetErred(10060) '连接远程主机超时
                Exit Do
            Else
                System.Threading.Thread.Sleep(500)
            End If
        Loop While True
        mConnectWait = Nothing
    End Sub
#End Region

#Region "保活包设置"
    Private mKeepAlive As Boolean
    ''' <summary>
    ''' 检测是否启用 Keep Alive 保活包功能，仅连接成功后设置才生效
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetKeepAlive() As Boolean
        Return mKeepAlive
    End Function

    ''' <summary>
    ''' 启用 Keep Alive 保活包功能
    ''' 重复发送一定次数（2000 XP 2003 系统默认为5次, Vista 后的系统默认为10次）没有回应后超时
    ''' </summary>
    ''' <param name="keepalivetime">多长时间（ms）没有数据就开始send心跳包</param>
    ''' <param name="keepaliveinterval">两次KeepAlive探测间的时间间隔（单位：毫秒）</param>
    ''' <remarks></remarks>
    Public Sub OpenKeepAlive(ByVal keepalivetime As UInteger, ByVal keepaliveinterval As UInteger)
        mKeepAlive = True
        '设置保活包
        Dim inPar(), outPar(), intbyte() As Byte
        ReDim inPar(11), outPar(50)
        'struct tcp_keepalive {
        '    ULONG onoff; //是否启用Keep-Alive
        '    ULONG keepalivetime; //多长时间（ms）没有数据就开始send心跳包
        '    ULONG keepaliveinterval;//两次KeepAlive探测间的时间间隔（单位：毫秒）
        '重复发送一定次数（2000 XP 2003 系统默认为5次, Vista 后的系统默认为10次）没有回应后超时
        '};

        '是否启用Keep-Alive
        inPar(0) = 1
        '多长时间后开始第一次探测（单位：毫秒）
        intbyte = ModTool.Int32ToByte(keepalivetime)
        Array.Reverse(intbyte)
        Array.Copy(intbyte, 0, inPar, 4, 4)
        '探测时间间隔（单位：毫秒）
        intbyte = ModTool.Int32ToByte(keepaliveinterval)
        Array.Reverse(intbyte)
        Array.Copy(intbyte, 0, inPar, 8, 4)
        Try
            Dim rtn As Integer = IOControl(IOControlCode.KeepAliveValues, inPar, outPar)
        Catch ex As Exception

        End Try

    End Sub

    ''' <summary>
    ''' 关闭 Keep Alive 保活包功能
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub CloseKeepAlive()
        mKeepAlive = False
        Dim inPar(), outPar() As Byte
        ReDim inPar(11), outPar(50)
        Dim rtn As Integer = IOControl(IOControlCode.KeepAliveValues, inPar, outPar)
    End Sub

#End Region



    ''' <summary>
    ''' 尝试连接指定服务器的操作结果回调函数
    ''' </summary>
    ''' <param name="ar"></param>
    ''' <remarks></remarks>
    Private Sub ConnectCallback(ByVal ar As IAsyncResult)
        '获取触发回调函数的 Socket 对象
        Dim oClient As TCPClientEx = CType(ar.AsyncState, TCPClientEx)

        mConnectResult = Nothing
        '关闭检测超时的线程
        mConnectTimeoutEnabled = False
        If mConnectWait IsNot Nothing Then
            mConnectWait.Join()
            mConnectWait = Nothing
        End If


        Try
            '结束回调函数        
            EndConnect(ar)

        Catch ex As SocketException
            SetErred(ex.SocketErrorCode)
            Return
        Catch exObj As ObjectDisposedException
            Debug.Print("ConnectCallback---ObjectDisposedException")
            SetCloseed()

            Return
        Catch ex As Exception
            Debug.Print("ConnectCallback Err" & ex.ToString)
        End Try

        mSocketState = SocketStateEnum.eConnected
        RaiseChanageEvent()

        '创建监听器，监听服务器发来的数据
        ReDim mBuffer(BufferSize)
        Try
            If Connected Then
                mReceiveResult = BeginReceive(mBuffer, 0, BufferSize, 0, New AsyncCallback(AddressOf ReadCallback), Me)
            Else
                SetCloseed()
            End If

        Catch ex As System.Net.Sockets.SocketException
            SetCloseed()
        End Try

    End Sub 'ConnectCallback 
#End Region

#Region "处理接收到的数据"

    ''' <summary>
    ''' 接收到数据后，触发此事件
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <param name="bRead"></param>
    ''' <remarks></remarks>
    Event OnDataReceive(ByVal oClient As TCPClientEx, ByVal bRead As Byte())

    Private mBuffer() As Byte
    Public Const BufferSize As Integer = 8192 '8K
    Private mReceiveResult As IAsyncResult '接收远端数据句柄

    ''' <summary>
    ''' 处理远端发送来的数据的函数
    ''' </summary>
    ''' <param name="ar"></param>
    ''' <remarks></remarks>
    Public Sub ReadCallback(ByVal ar As IAsyncResult)
        Dim sRead As String = String.Empty '接收到的数据明文
        mReceiveResult = Nothing
        If mSocketState = SocketStateEnum.eCloseed Then
            Return
        End If

        '获取客户端状态对象
        Dim oClient As TCPClientEx = CType(ar.AsyncState, TCPClientEx)


        '获取缓存中数据长度   
        Dim bytesRead As Integer
        Try
            If oClient Is Nothing Then Return
            If mSocketState = SocketStateEnum.eCloseed Then Return
            bytesRead = EndReceive(ar)
        Catch ex As SocketException
            Debug.Print("ReadCallback---SocketException" & ex.ToString)
            SetErred(ex.SocketErrorCode)
            Return
        Catch ex As ObjectDisposedException
            Debug.Print("ReadCallback---ObjectDisposedException")
            If mSocketState = SocketStateEnum.eCloseed Then Return
            SetCloseed()
            Return
        Catch ex As InvalidOperationException
            Debug.Print("ReadCallback -- InvalidOperationException --" & ex.ToString)
            Return
        Catch ex As Exception
            Debug.Print("ReadCallback Err --" & ex.ToString)
        End Try

        If bytesRead > 0 Then
            '转换数组为字符串
            Dim bRead() As Byte = copyOfRange(mBuffer, 0, bytesRead)
            RaiseEvent OnDataReceive(Me, bRead)

            BeginReceiveEx()


        Else
            '连接已关闭
            SetCloseed()
        End If

    End Sub 'ReadCallback  

    ''' <summary>
    ''' 是否正接收数据
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function IsReceiveing() As Boolean
        If mReceiveResult IsNot Nothing Then
            If mReceiveResult.IsCompleted Then
                mReceiveResult = Nothing
            End If
        End If
        Return (mReceiveResult IsNot Nothing)
    End Function

    ''' <summary>
    ''' 停止接收数据
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function EndReceiveEx() As Boolean
        If IsReceiveing() Then
            If State = SocketStateEnum.eCloseed Then
                Return True
            End If
            If mReceiveResult Is Nothing Then Return True

            Try
                EndReceive(mReceiveResult)
            Catch ex As Exception
                mReceiveResult = Nothing
                Return True
            End Try

        End If
        Return True
    End Function

    ''' <summary>
    ''' 开始接收数据
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function BeginReceiveEx() As Boolean
        If IsConnected() Then
            If Not IsReceiveing() Then
                '开始接收数据
                Array.Clear(mBuffer, 0, mBuffer.Length - 1)
                '继续读取缓存
                BeginReceive(mBuffer, 0, BufferSize, 0, New AsyncCallback(AddressOf ReadCallback), Me)
            End If

            Return True
        Else
            Return False
        End If
    End Function
#End Region

#Region "发送数据事件"
    ''' <summary>
    ''' 发送数据包的信息
    ''' </summary>
    ''' <remarks></remarks>
    Private Class SendInfo
        'Public SendData() As Byte
        Public SendTime As Date
        Public UserData As Object
    End Class

    Private mSendResult As IAsyncResult '发送数据至服务器的操作句柄
    ''' <summary>
    ''' 往服务器发送数据
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub SendEx(ByVal data() As Byte, ByVal oUserData As Object)
        '转换明文为字节数组     
        'Dim byteData As Byte() = {}
        '异步发送  

        Dim state As New SendInfo
        'state.SendData = byteData
        state.SendTime = Date.Now
        state.UserData = oUserData

        mSendResult = Nothing
        Try
            mSendResult = BeginSend(data, 0, data.Length, 0, New AsyncCallback(AddressOf SendCallback), state)
        Catch ex As SocketException
            SetErred(ex.SocketErrorCode)
            Return
        Catch exDis As ObjectDisposedException
            Debug.Print("SendEx--ObjectDisposedException")
        Catch ex As Exception
            Debug.Print("SendEx Err" & ex.ToString)
        End Try

    End Sub 'Send   

    ''' <summary>
    ''' 数据已经成功投递到服务器
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <param name="oUserPar"></param>
    ''' <param name="iSendByteCount">已发送的字节数</param>
    ''' <param name="SendDate"></param>
    ''' <param name="SendCompleteDate"></param>
    ''' <remarks></remarks>
    Event OnSendComplete(ByVal oClient As TCPClientEx, ByVal oUserPar As Object, ByVal iSendByteCount As Integer, ByVal SendDate As Date, ByVal SendCompleteDate As Date)

    ''' <summary>
    ''' 发送数据完毕
    ''' </summary>
    ''' <param name="ar"></param>
    ''' <remarks></remarks>
    Private Sub SendCallback(ByVal ar As IAsyncResult)
        '获取客户端对象
        Dim state As SendInfo = CType(ar.AsyncState, SendInfo)
        mSendResult = Nothing

        '返回发送的字节数
        Dim bytesSend As Integer
        Try
            bytesSend = EndSend(ar)
        Catch ex As SocketException
            SetErred(ex.SocketErrorCode)
            Return
        Catch exDis As ObjectDisposedException
            Debug.Print("SendCallback ---ObjectDisposedException")
            SetCloseed()
            Return
        Catch ex As Exception
            Debug.Print("SendCallback Err" & ex.ToString)
        End Try

        RaiseEvent OnSendComplete(Me, state.UserData, bytesSend, state.SendTime, Date.Now)

    End Sub 'SendCallback

    ''' <summary>
    ''' 是否正在发送数据
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function IsSending() As Boolean
        If mSendResult IsNot Nothing Then
            If mSendResult.IsCompleted Then
                mSendResult = Nothing
            End If
        End If
        Return (mSendResult IsNot Nothing)
    End Function
#End Region


#Region "关闭Socket"
    ''' <summary>
    ''' 关闭Socket
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub CloseSocket()

        'If mDNSResult IsNot Nothing Then
        '    'If Not mDNSResult.IsCompleted Then
        '    '    mDNSResult.AsyncWaitHandle.Close
        '    'End If


        '    mDNSResult = Nothing
        'End If

        mDNSResult = Nothing

        If IsConnected() Then
            Try
                Shutdown(SocketShutdown.Both)
            Catch ex As Exception
                Debug.Print("CloseSocket -- " & ex.ToString)
            End Try


            If IsReceiveing() Then
                mReceiveResult = Nothing
            End If
        End If

        mSendResult = Nothing
        mReceiveResult = Nothing
        mConnectResult = Nothing

        SetCloseed(False)
    End Sub


    ''' <summary>
    ''' 设置为关闭状态
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub SetCloseed()
        SetCloseed(True)
    End Sub

    ''' <summary>
    ''' 设置为关闭状态
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub SetCloseed(ByVal ShowEvent As Boolean)
        If mSocketState = SocketStateEnum.eCloseed Then Return

        mSocketState = SocketStateEnum.eCloseed
        mSocketErrCode = 0
        MyBase.Close()
        If ShowEvent Then RaiseChanageEvent()
    End Sub

    ''' <summary>
    ''' 设置状态为错误
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub SetErred(ByVal lErrNum As Integer)
        mSocketErrCode = lErrNum
        mSocketState = SocketStateEnum.eErr

        RaiseChanageEvent()
    End Sub
#End Region


    ''' <summary>
    ''' 获取错误代码的描述
    ''' </summary>
    ''' <param name="iErrCode"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ErrorCodeToString(ByVal iErrCode As String) As String
        Select Case iErrCode
            Case 11001
                Return "DNS 返回结果：服务器地址不存在！"
            Case 11004
                Return "Dns(返回结果) : 服务器地址有效, 但无法连接到服务器!"
            Case 10060
                Return "连接远程主机超时。"
            Case 10061
                Return "连接到服务器失败，连接被拒绝。"
            Case 10053
                Return "服务器连接丢失，已断开连接（超时或网络故障）!"
            Case 10054
                Return "服务器连接已断开连接（超时或网络故障）!"
            Case Else
                Return "ErrCode -- " & iErrCode.ToString
        End Select
    End Function
End Class
